{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-}
module Magicloud.Yesod.Snmp.TH where

import Network.Protocol.NetSNMP
import Magicloud.Snmp
import Magicloud.List
import qualified Data.Text as T
import qualified Data.Map as M
import Language.Haskell.TH
import Data.Maybe()
import Data.Time.Clock.POSIX
import GHC.Float
import Data.Int
import Data.Time.Clock

class FromSnmp a where
  fromSnmp :: M.Map OID ASNValue -> a

class ToExp a where
  toExp :: a -> Exp

instance ToExp OID where
  toExp = ListE . map (LitE . IntegerL . fromIntegral)

fromSnmpTH :: Name -> M.Map Name OID -> Q [Dec]
fromSnmpTH typeName field_oid = do
  info <- reify typeName
  let srs = mkName "srs"
  case info of
    TyConI (DataD _ _ _ [RecC conName fields] _) -> do
      fieldExps <- filterMaybeM (\(fieldName, _, fieldType) -> do
                                    case fieldType of -- AppT ListT (ConT Int)
                                      ConT fieldTypeName -> -- field must exists in field_oid, todo: persist list and map
                                        case M.lookup fieldName field_oid of
                                          Nothing -> fail ("Field " ++ (show fieldName) ++ " is missing in field_oid")
                                          Just oid_ -> return $
                                            Just (fieldName, AppE (VarE $ mkName ("ex" ++ (nameBase fieldTypeName)))
                                                                  (InfixE (Just (VarE srs))
                                                                          (VarE $ mkName "M.!")
                                                                          (Just (toExp oid_))))
                                      AppT (ConT maybe_) (ConT fieldTypeName) -> -- field could be missing in field_oid
                                        if maybe_ == ''Maybe then
                                          case M.lookup fieldName field_oid of
                                            Nothing -> return $ Just (fieldName, ConE 'Nothing)
                                            Just oid_ -> return $
                                              Just (fieldName, AppE (ConE 'Just)
                                                                    (AppE (VarE $ mkName ("ex" ++ (nameBase fieldTypeName)))
                                                                          (InfixE (Just (VarE srs))
                                                                                  (VarE $ mkName "M.!")
                                                                                  (Just (toExp oid_)))))
                                        else
                                          fail "Unexpected type"
                                      _ -> fail "Unexpected type"
                                ) fields
      return $ [InstanceD [] (AppT (ConT ''FromSnmp)
                                   (ConT typeName))
                             [FunD 'fromSnmp [Clause [VarP srs] (NormalB $ RecConE conName fieldExps) []]]]
    _ -> fail "Unexpected type"

exText :: ASNValue -> T.Text
exText (OctetString s _) = T.pack s
exText _ = T.pack ""
-- exByteString :: ASNValue -> ByteString
-- exByteString _ = undefined
exInt64 :: ASNValue -> Int64
exInt64 (Integer32 i) = fromIntegral i
exInt64 (Integer64 i) = fromIntegral i
exInt64 (Counter32 i) = fromIntegral i
exInt64 (Counter64 i) = fromIntegral i
exInt64 (Unsigned32 i) = fromIntegral i
exInt64 (Unsigned64 i) = fromIntegral i
exInt64 (Gauge32 i) = fromIntegral i
exInt64 _ = 0
exDouble :: ASNValue -> Double
exDouble (IEEEFloat f) = float2Double f
exDouble (IEEEDouble f) = f
exDouble _ = 0
exBool :: ASNValue -> Bool
exBool (Boolean b) = b
exBool _ = False
-- Day TimeOfDay
exUTCTime :: ASNValue -> UTCTime
exUTCTime (TimeTicks _ w) = posixSecondsToUTCTime $ realToFrac ((fromIntegral w) / (1000.0 :: Double))
exUTCTime _ = posixSecondsToUTCTime 0
-- oid and ipaddress to be list
